Hardcore Visual Basic 5.0 (2nd Edition)/Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso/Code/Goodies/NAMESP~1/NSTREE.FR_/NSTREE.FR

Text File | 1997-06-04 | 14KB | 447 lines

VERSION 5.00
Object = "{721C2D87-B82E-11D0-B8ED-00608CC9A71F}#1.0#0"; "Awnsctrl.ocx"
Begin VB.Form frmNSTreeDemo
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "ActiveX NameSpaceTree Control Demo"
   ClientHeight    =   6840
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8760
   Icon            =   "NSTree.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6840
   ScaleWidth      =   8760
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdClose
      Caption         =   "Close"
      Height          =   315
      Left            =   7260
      TabIndex        =   24
      Top             =   720
      Width           =   1335
   End
   Begin VB.Frame fraSelFolder
      Caption         =   "Selected Folder"
      Height          =   2415
      Left            =   120
      TabIndex        =   14
      Top             =   2340
      Width           =   3675
      Begin VB.CommandButton cmdPath
         Caption         =   "Path:"
         Height          =   315
         Left            =   60
         TabIndex        =   21
         Top             =   1080
         Width           =   615
      End
      Begin VB.CommandButton cmdSave
         Caption         =   "Save Folder"
         Height          =   315
         Left            =   120
         TabIndex        =   20
         Top             =   240
         Width           =   1515
      End
      Begin VB.CommandButton cmdRestore
         Caption         =   "Resore Folder"
         Height          =   315
         Left            =   1980
         TabIndex        =   19
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label lblFolderIDL
         Caption         =   "FolderIDL:"
         Height          =   915
         Left            =   120
         TabIndex        =   18
         Top             =   1440
         Width           =   3435
      End
      Begin VB.Label lblFolderAttributes
         Caption         =   "FolderAttributes:"
         Height          =   195
         Left            =   120
         TabIndex        =   17
         Top             =   840
         Width           =   3075
      End
      Begin VB.Label lblPath
         Caption         =   "lblPath"
         Height          =   195
         Left            =   780
         TabIndex        =   16
         Top             =   1140
         Width           =   2715
      End
      Begin VB.Label lblFolderName
         Caption         =   "FolderName:"
         Height          =   195
         Left            =   120
         TabIndex        =   15
         Top             =   600
         Width           =   3075
      End
   End
   Begin VB.Frame fraAppearance
      Caption         =   "Appearance"
      Height          =   1515
      Left            =   120
      TabIndex        =   8
      Top             =   780
      Width           =   3675
      Begin VB.CheckBox chkAppearance
         Caption         =   "Appearance 3D"
         Height          =   195
         Left            =   120
         TabIndex        =   13
         Top             =   240
         Value           =   1  'Checked
         Width           =   1935
      End
      Begin VB.CheckBox chkBorderStyle
         Caption         =   "BorderStyle"
         Height          =   195
         Left            =   120
         TabIndex        =   12
         Top             =   480
         Value           =   1  'Checked
         Width           =   1935
      End
      Begin VB.CheckBox chkEnabled
         Caption         =   "Enabled"
         Height          =   195
         Left            =   120
         TabIndex        =   11
         Top             =   720
         Value           =   1  'Checked
         Width           =   1275
      End
      Begin VB.CheckBox chkHideSelection
         Caption         =   "HideSelection"
         Height          =   195
         Left            =   120
         TabIndex        =   10
         Top             =   960
         Width           =   1935
      End
      Begin VB.CheckBox chkIncludeHiddenSystem
         Caption         =   "IncludeHiddenSystem"
         Height          =   195
         Left            =   120
         TabIndex        =   9
         Top             =   1200
         Width           =   2535
      End
   End
   Begin VB.Frame fraRoot
      Caption         =   "Root Folder"
      Height          =   1875
      Left            =   120
      TabIndex        =   3
      Top             =   4800
      Width           =   3675
      Begin VB.CommandButton cmdRootDIR
         Caption         =   "RootDIR:"
         Height          =   315
         Left            =   60
         TabIndex        =   22
         Top             =   600
         Width           =   855
      End
      Begin VB.ComboBox cboRootSFN
         Height          =   315
         Left            =   900
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   240
         Width           =   2655
      End
      Begin VB.Label lblRootIDL
         Caption         =   "RootIDL:"
         Height          =   855
         Left            =   120
         TabIndex        =   7
         Top             =   960
         Width           =   3315
      End
      Begin VB.Label lblRootSFN
         Caption         =   "RootSFN:"
         Height          =   195
         Left            =   120
         TabIndex        =   6
         Top             =   300
         Width           =   675
      End
      Begin VB.Label lblRootDIR
         Caption         =   "lblRootDIR"
         Height          =   195
         Left            =   1020
         TabIndex        =   4
         Top             =   660
         Width           =   2535
      End
   End
   Begin VB.TextBox txtEvents
      Height          =   1815
      Left            =   3960
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   4860
      Width           =   4635
   End
   Begin AWNSCTRL.NSTree NSTree
      Height          =   3435
      Left            =   3960
      TabIndex        =   0
      Top             =   1140
      Width           =   4635
      _ExtentX        =   8176
      _ExtentY        =   6059
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      HideSelection   =   0   'False
      MouseIcon       =   "NSTree.frx":000C
   End
   Begin VB.Label lblNSTree
      Caption         =   "NameSpaceTree Control:"
      Height          =   195
      Left            =   3960
      TabIndex        =   25
      Top             =   840
      Width           =   2895
   End
   Begin VB.Label lblTitle
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Acuteware NameSpaceTree"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   24
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   675
      Left            =   0
      TabIndex        =   23
      Top             =   0
      Width           =   8775
   End
   Begin VB.Label lblEvents
      Caption         =   "Events:"
      Height          =   195
      Left            =   3960
      TabIndex        =   2
      Top             =   4620
      Width           =   1455
   End
End
Attribute VB_Name = "frmNSTreeDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mvIDL As Variant

Private Sub cboRootSFN_Click()
    If cboRootSFN.ListIndex <> -1 Then
        NSTree.RootSFN = cboRootSFN.ItemData(cboRootSFN.ListIndex)
        Call ShowProperies
    End If
End Sub

Private Sub chkAppearance_Click()
    NSTree.Appearance = chkAppearance
End Sub

Private Sub chkBorderStyle_Click()
    NSTree.BorderStyle = chkBorderStyle
End Sub

Private Sub chkEnabled_Click()
    NSTree.Enabled = (chkEnabled = vbChecked)
End Sub

Private Sub chkHideSelection_Click()
    NSTree.HideSelection = (chkHideSelection = vbChecked)
End Sub

Private Sub chkIncludeHiddenSystem_Click()
    NSTree.IncludeHiddenSystem = (chkIncludeHiddenSystem = vbChecked)
End Sub


Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdPath_Click()
    Dim sPath As String

    sPath = InputBox("Enter the Folder Directory (Path):", "Folder Directory", NSTree.Path)
    If Len(sPath) = 0 Then Exit Sub

    On Error Resume Next
    NSTree.Path = sPath
    If Err Then MsgBox Err.Description, vbInformation
    Call ShowProperies
End Sub

Private Sub cmdRestore_Click()
    If Not IsEmpty(mvIDL) Then NSTree.FolderIDL = mvIDL
End Sub

Private Sub cmdRootDIR_Click()
    Dim sPath As String

    sPath = InputBox("Enter a Root Directory:", "Root Directory", NSTree.RootDIR)
    If Len(sPath) = 0 Then Exit Sub

    On Error Resume Next
    NSTree.RootDIR = sPath
    If Err Then MsgBox Err.Description, vbInformation
    Call ShowProperies
End Sub

Private Sub cmdSave_Click()
    mvIDL = NSTree.FolderIDL
End Sub

Private Sub Form_Load()
    Me.Move 0, 0

    Call ComboRootAdd("sfnDesktopNS", sfnDesktopNS)
    Call ComboRootAdd("sfnProgramsDir", sfnProgramsDir)
    Call ComboRootAdd("sfnControlPanelNS", sfnControlPanelNS)
    Call ComboRootAdd("sfnPrintersNS", sfnPrintersNS)
    Call ComboRootAdd("sfnMyDocumentsDir", sfnMyDocumentsDir)
    Call ComboRootAdd("sfnFavoritesDir", sfnFavoritesDir)
    Call ComboRootAdd("sfnStartUpDir", sfnStartUpDir)
    Call ComboRootAdd("sfnRecentDir", sfnRecentDir)
    Call ComboRootAdd("sfnSendToDir", sfnSendToDir)
    Call ComboRootAdd("sfnRecycleBinNS", sfnRecycleBinNS)
    Call ComboRootAdd("sfnStartMenuDir", sfnStartMenuDir)
    Call ComboRootAdd("sfnDesktopDir", sfnDesktopDir)
    Call ComboRootAdd("sfnMyComputerNS", sfnMyComputerNS)
    Call ComboRootAdd("sfnNetworkNeighborhoodNS", sfnNetworkNeighborhoodNS)
    Call ComboRootAdd("sfnNetHoodDir", sfnNetHoodDir)
    Call ComboRootAdd("sfnFontsDir", sfnFontsDir)
    Call ComboRootAdd("sfnShellNewDir", sfnShellNewDir)

    Call ShowProperies
End Sub



Private Function ComboRootAdd(sText$, lItemData&) As Long
    Dim lNewIndex As Long

    cboRootSFN.AddItem CStr(lItemData) & " - " & sText
    lNewIndex = cboRootSFN.NewIndex
    cboRootSFN.ItemData(lNewIndex) = lItemData
    ComboRootAdd = lNewIndex
End Function

Private Sub Form_Unload(Cancel As Integer)
    NSTree.AboutBox
End Sub

Private Sub NSTree_Error(ByVal Number As Long, Message As String, Title As String, Retry As Boolean)
    Call ShowEvent("NSTree_Error " & Message)
End Sub

Private Sub NSTree_FolderChange()
    Call ShowEvent("NSTree_FolderChange  " & NSTree.FolderName)
    Call ShowProperies
End Sub

Private Sub ShowEvent(sMsg$)
    If Len(txtEvents) > 10000 Then txtEvents = Right$(txtEvents, 10000)
    txtEvents.SelStart = Len(txtEvents)
    txtEvents.SelText = sMsg & vbCrLf
End Sub

Private Function DisplayIDL_s(vIDL) As String
    Dim sTmp As String
    Dim x As Long
    Dim cnt As Integer

    For x = 0 To UBound(vIDL)
        cnt = cnt + 1
        sTmp = sTmp & Hex$(vIDL(x))
        If cnt = 10 Then
            sTmp = sTmp & vbCrLf
            cnt = 0
        Else
            sTmp = sTmp & "-"
        End If
    Next
    DisplayIDL_s = sTmp
End Function


Private Sub ComboSync(cbo As ComboBox, lItemData&)
    Dim iIndex As Integer

    If cbo.ListIndex >= 0 Then
        If cbo.ItemData(cbo.ListIndex) = lItemData Then Exit Sub
    End If
    For iIndex = 0 To cbo.ListCount - 1
        If cbo.ItemData(iIndex) = lItemData Then
            cbo.ListIndex = iIndex
            Exit Sub
        End If
    Next
    cbo.ListIndex = -1 'Not found
End Sub

Private Sub ShowProperies()
    lblFolderName = "FolderName: " & NSTree.FolderName
    lblFolderAttributes = "FolderAttributes: " & Hex$(NSTree.FolderAttributes)
    lblPath = NSTree.Path
    lblFolderIDL = "FolderIDL: " & DisplayIDL_s(NSTree.FolderIDL)

    lblRootDIR = NSTree.RootDIR
    lblRootIDL = "RootIDL: " & DisplayIDL_s(NSTree.RootIDL)
    Call ComboSync(cboRootSFN, NSTree.RootSFN)
End Sub

Private Sub NSTree_KeyDown(KeyCode As Integer, Shift As Integer)
    Call ShowEvent("NSTree_KeyDown")
End Sub

Private Sub NSTree_KeyPress(KeyAscii As Integer)
    Call ShowEvent("NSTree_KeyPress")
End Sub

Private Sub NSTree_KeyUp(KeyCode As Integer, Shift As Integer)
    Call ShowEvent("NSTree_KeyUp")
End Sub

Private Sub NSTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ShowEvent("NSTree_MouseDown")
End Sub

Private Sub NSTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ShowEvent("NSTree_MouseUp")
End Sub